home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbbin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-22  |  19.5 KB  |  554 lines
  1. (*===========================================================================*)
  2. (* Binary upload download processor                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1986  Jeffry B. Jacobsen.  All rights reserved.               *)
  5. (*   Copyright 1989, 1991 by H. Roy Engehausen.  All rights reserved.        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$UNDEF DEBUG_OPR}
  10.  
  11. {$O+}
  12.  
  13. UNIT BBBIN;
  14.  
  15. INTERFACE
  16.  
  17.   USES
  18.     bbdummy;
  19.  
  20.   PROCEDURE bin_cmd(cmd_string : STRING);
  21.  
  22. IMPLEMENTATION
  23.  
  24. USES
  25.   CRT,
  26.   DOS,
  27.   bbconvm,
  28.   bbcopy,
  29.   bbfsm,
  30.   bblog,
  31.   bblstr,
  32.   bbmdata,
  33.   bbmem,
  34.   bbmess,
  35.   bbmisc,
  36.   bbmisc4,
  37.   bbmisc5,
  38.   bbrdata,
  39.   bbrunerr,
  40.   bbsdata,
  41.   bbsema2,
  42.   bbsess,
  43.   bbstr,
  44.   bbtask,
  45.   bbtime,
  46.   bbwin;
  47.  
  48. PROCEDURE bin_cmd(cmd_string : STRING);
  49.  
  50.   (*-------------------------------------------------------------------------*)
  51.   (* These are the global vars                                               *)
  52.   (*-------------------------------------------------------------------------*)
  53.  
  54.   TYPE
  55.  
  56.     bin_xfer_type   = (bin_unknown,
  57.                        bin_xmodem,
  58.                        bin_xmodemcrc,
  59.                        bin_ymodem,
  60.                        bin_ymodem_batch,
  61.                        bin_yapp);
  62.  
  63.   VAR
  64.  
  65.     abort_sw        : BOOLEAN;
  66.     bin_xfer        : bin_xfer_type;
  67.     bin_mode        : STRING[15];
  68.     bytes_per_block : WORD;
  69.     code            : INTEGER;
  70.     conv_sw         : BOOLEAN;
  71.     dir_to_search   : fsb_name_str;
  72.     i               : WORD;
  73.     look            : SEARCHREC;
  74.     p               : STRING[4];
  75.     pkfname         : file_name_str;
  76.     save_show       : BOOLEAN;
  77.     search_arg      : file_name_str;
  78.     send_switch     : BOOLEAN;
  79.     show_xmit_count : BYTE;
  80.     this_fsb        : fsb_ptr;
  81.     this_msg        : msg_index_ptr;
  82.     up_it           : BOOLEAN;
  83.     word_count      : BYTE;
  84.     work_string     : STRING[125];
  85.  
  86.   (*=========================================================================*)
  87.   (* External general subroutines                                            *)
  88.   (*=========================================================================*)
  89.  
  90.   {$I BBMACRO.PAS}
  91.   {$I BBFSI.PAS}
  92.   {$I BBBINM.PAS}
  93.  
  94.   (*=========================================================================*)
  95.   (* Binary transfer routines                                                *)
  96.   (*=========================================================================*)
  97.  
  98.   {$I BBYAPP0.PAS}
  99.   {$I BBXYMOD.PAS}
  100.  
  101.   (*=========================================================================*)
  102.   (* Main line                                                               *)
  103.   (*=========================================================================*)
  104.  
  105.   BEGIN;
  106.  
  107.     {$IFDEF DEBUG_OPR}
  108.       WRITELN('Bin -- ', cmd_string , ' -- ', active_tcb^.port_chan_s);
  109.     {$ENDIF}
  110.  
  111.     (*-----------------------------------------------------------------------*)
  112.     (* Initialize switches                                                   *)
  113.     (*-----------------------------------------------------------------------*)
  114.  
  115.     send_switch := TRUE;
  116.  
  117.     abort_sw    := FALSE;
  118.  
  119.     conv_sw     := active_tcb^.conv_tcb <> NIL;
  120.  
  121.     p           := active_tcb^.port_chan_s + 'B:';
  122.  
  123.     free_task_mem('$1', TRUE);
  124.  
  125.     (*-----------------------------------------------------------------------*)
  126.     (* If this is the operator task, prevent him from doing something        *)
  127.     (* stupid.  Then pass the command to the conversing task                 *)
  128.     (*-----------------------------------------------------------------------*)
  129.  
  130.     IF active_tcb^.tcb_type = th_operator THEN
  131.       BEGIN;
  132.  
  133.         {$IFDEF DEBUG_OPR}
  134.           WRITELN('Bin switch task');
  135.         {$ENDIF}
  136.  
  137.         (*-------------------------------------------------------------------*)
  138.         (* Can't transfer with out anybody connected                         *)
  139.         (*-------------------------------------------------------------------*)
  140.  
  141.         IF NOT conv_sw THEN
  142.           BEGIN;
  143.             send_message(message_need_conv);
  144.             active_tcb^.error_sw := TRUE;
  145.             EXIT;
  146.           END;
  147.  
  148.         (*-------------------------------------------------------------------*)
  149.         (* Command remote end and leave                                      *)
  150.         (*-------------------------------------------------------------------*)
  151.  
  152.         cmd_string := escape + escape + cmd_string;
  153.         add_c_string(active_tcb^.conv_tcb, @cmd_string, 0);
  154.  
  155.         EXIT;
  156.  
  157.       END;
  158.  
  159.     (*-----------------------------------------------------------------------*)
  160.     (* Parse command                                                         *)
  161.     (*-----------------------------------------------------------------------*)
  162.  
  163.     upcase_str_var(cmd_string);
  164.  
  165.     word_count := words(cmd_string);
  166.  
  167.     IF word_count <> 4 THEN
  168.       BEGIN;
  169.         IF word_count < 4 THEN
  170.           do_mess(message_not_en)
  171.         ELSE
  172.           do_mess(message_err_wrd);
  173.         active_tcb^.error_sw := TRUE;
  174.         EXIT;
  175.       END;
  176.  
  177.     (*-----------------------------------------------------------------------*)
  178.     (* Set direction.                                                        *)
  179.     (*-----------------------------------------------------------------------*)
  180.  
  181.     up_it := cmd_string[1] = 'U';
  182.  
  183.     (*-----------------------------------------------------------------------*)
  184.     (* Parse                                                                 *)
  185.     (*-----------------------------------------------------------------------*)
  186.  
  187.     bin_mode      := subword(@cmd_string, 2, 1);
  188.  
  189.     dir_to_search := subword(@cmd_string, 3, 1);
  190.  
  191.     search_arg    := subword(@cmd_string, 4, 1);
  192.  
  193.     (*-----------------------------------------------------------------------*)
  194.     (* Test the binary file transfer type                                    *)
  195.     (*-----------------------------------------------------------------------*)
  196.  
  197.     bin_xfer := bin_unknown;
  198.     IF bin_mode = 'XMODEM' THEN
  199.       bin_xfer := bin_xmodem;
  200.     IF bin_mode = 'XMODEMCRC' THEN
  201.       bin_xfer := bin_xmodemcrc;
  202.     IF bin_mode = 'YMODEM' THEN
  203.       bin_xfer := bin_ymodem;
  204.     IF bin_mode = 'YMBATCH' THEN
  205.       bin_xfer := bin_ymodem_batch;
  206.     IF bin_mode = 'YMODEM-BATCH' THEN
  207.       bin_xfer := bin_ymodem_batch;
  208.     IF bin_mode = 'YAPP' THEN
  209.       bin_xfer := bin_yapp;
  210.  
  211.     IF bin_xfer = bin_unknown THEN
  212.       BEGIN;
  213.         do_mess(message_bad_bin);
  214.         active_tcb^.error_sw := TRUE;
  215.         EXIT;
  216.       END;
  217.  
  218.     (*-----------------------------------------------------------------------*)
  219.     (* Find the directory                                                    *)
  220.     (*-----------------------------------------------------------------------*)
  221.  
  222.     {$IFDEF DEBUG_OPR}
  223.       WRITELN('Dir');
  224.     {$ENDIF}
  225.  
  226.     work_string := active_tcb^.port_chan_s + 'B:';
  227.     i           := 1 + ORD(active_tcb^.uid_data.user_class);
  228.  
  229.     this_fsb := find_fsb(dir_to_search);
  230.  
  231.     IF (this_fsb = NIL) OR
  232.                    (active_tcb^.uid_data.user_class < this_fsb^.fsb_down) THEN
  233.       BEGIN;
  234.  
  235.         IF this_fsb = NIL THEN
  236.           window_write(work_string, 'Unknown data area for transfer')
  237.         ELSE
  238.           window_write(work_string, 'Insufficent authority for download -- '
  239.                                                        + user_class_string[i]);
  240.  
  241.         do_mess(message_no_files_one);
  242.         active_tcb^.error_sw := TRUE;
  243.  
  244.         EXIT;
  245.  
  246.       END;
  247.  
  248.     IF up_it AND (active_tcb^.uid_data.user_class < this_fsb^.fsb_up) THEN
  249.       BEGIN;
  250.  
  251.         window_write(work_string, 'Insufficent authority for upload -- '
  252.                                                        + user_class_string[i]);
  253.  
  254.         do_mess(message_no_files_one);
  255.         active_tcb^.error_sw := TRUE;
  256.  
  257.         EXIT;
  258.  
  259.       END;
  260.  
  261.     (*-----------------------------------------------------------------------*)
  262.     (* Check for subdirectory                                                *)
  263.     (*-----------------------------------------------------------------------*)
  264.  
  265.     IF (POS('\', search_arg) > 0) AND NOT this_fsb^.fsb_f_subdir_ok THEN
  266.       BEGIN;
  267.         do_mess(message_no_slash);
  268.         active_tcb^.error_sw := TRUE;
  269.         EXIT;
  270.       END;
  271.  
  272.     (*-----------------------------------------------------------------------*)
  273.     (* Check for wildcards                                                   *)
  274.     (*-----------------------------------------------------------------------*)
  275.  
  276.     IF (POS('*', search_arg) > 0) THEN
  277.       BEGIN;
  278.         do_mess(message_no_wild);
  279.         active_tcb^.error_sw := TRUE;
  280.         EXIT;
  281.       END;
  282.  
  283.     (*-----------------------------------------------------------------------*)
  284.     (* Binary ok?                                                            *)
  285.     (*-----------------------------------------------------------------------*)
  286.  
  287.     IF NOT this_fsb^.fsb_binary OR active_port^.port_no_binary THEN
  288.       BEGIN;
  289.         do_mess(message_no_binary);
  290.         active_tcb^.error_sw := TRUE;
  291.         EXIT;
  292.       END;
  293.  
  294.     (*-----------------------------------------------------------------------*)
  295.     (* Build file name                                                       *)
  296.     (*-----------------------------------------------------------------------*)
  297.  
  298.     {$IFDEF DEBUG_OPR}
  299.       WRITELN('Build name');
  300.     {$ENDIF}
  301.  
  302.     work_string := this_fsb^.fsb_path + search_arg;
  303.  
  304.     (*-----------------------------------------------------------------------*)
  305.     (* Test the file                                                         *)
  306.     (*-----------------------------------------------------------------------*)
  307.  
  308.     i := file_test(work_string);
  309.  
  310.     {$IFDEF DEBUG_OPR}
  311.       WRITELN('Filetest -- ', i);
  312.     {$ENDIF}
  313.  
  314.     IF up_it THEN
  315.       BEGIN;
  316.  
  317.         (*-------------------------------------------------------------------*)
  318.         (* If we are "uploading" it then it must not exist already           *)
  319.         (*-------------------------------------------------------------------*)
  320.  
  321.         IF i = 0 THEN
  322.           BEGIN;
  323.             do_mess(message_file_exists);
  324.             active_tcb^.error_sw := TRUE;
  325.             EXIT;
  326.           END;
  327.  
  328.       END
  329.     ELSE
  330.       BEGIN;
  331.  
  332.         (*-------------------------------------------------------------------*)
  333.         (* If we are "downloading" then the file MUST exist                  *)
  334.         (*-------------------------------------------------------------------*)
  335.  
  336.         IF i <> 0 THEN
  337.           BEGIN;
  338.             do_mess(message_file_no_exist);
  339.             active_tcb^.error_sw := TRUE;
  340.             EXIT;
  341.           END;
  342.  
  343.       END;
  344.  
  345.     (*-----------------------------------------------------------------------*)
  346.     (* All other open errors are caught here                                 *)
  347.     (*-----------------------------------------------------------------------*)
  348.  
  349.     IF (i <> 0) AND (i <> 2) THEN
  350.       BEGIN;
  351.  
  352.         work_string := dos_err_message(i) + cr;
  353.  
  354.         IF conv_sw THEN
  355.           window_write(p, work_string)
  356.         ELSE
  357.           send_tnc_data_str(work_string);
  358.  
  359.         active_tcb^.error_sw := TRUE;
  360.         EXIT;
  361.       END;
  362.  
  363.     (*-----------------------------------------------------------------------*)
  364.     (* Set block size for YAPP                                               *)
  365.     (*-----------------------------------------------------------------------*)
  366.  
  367.     {$IFDEF DEBUG_OPR}
  368.       WRITELN('Block size');
  369.     {$ENDIF}
  370.  
  371.     bytes_per_block := active_tcb^.max_pac;
  372.     IF bytes_per_block > 10 THEN
  373.       DEC(bytes_per_block, 2);
  374.     IF bytes_per_block < 5 THEN
  375.       bytes_per_block := 250;
  376.  
  377.     (*-----------------------------------------------------------------------*)
  378.     (* Get a file block to hold the info                                     *)
  379.     (*-----------------------------------------------------------------------*)
  380.  
  381.     IF active_tcb^.io_fe <> NIL THEN
  382.       BEGIN;
  383.         {$I-}
  384.         CLOSE(active_tcb^.io_fe^.fe_text);
  385.         i := IORESULT;
  386.         {$I+}
  387.       END
  388.     ELSE
  389.       BEGIN;
  390.         NEW(active_tcb^.io_fe);
  391.         FILLCHAR(active_tcb^.io_fe^, SIZEOF(active_tcb^.io_fe^), CHR(0));
  392.       END;
  393.  
  394.     active_tcb^.io_fe^.fe_type := TRUE;
  395.  
  396.     (*-----------------------------------------------------------------------*)
  397.     (* Tell user to start                                                    *)
  398.     (*-----------------------------------------------------------------------*)
  399.  
  400.     set_dollar1_parm(@bin_mode);
  401.     do_mess(message_start_bin);
  402.     send_flush;
  403.  
  404.     (*-----------------------------------------------------------------------*)
  405.     (* Obtain the interrupt semaphore                                        *)
  406.     (*-----------------------------------------------------------------------*)
  407.  
  408.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  409.  
  410.     (*-----------------------------------------------------------------------*)
  411.     (* See if we are sending or receiving                                    *)
  412.     (*-----------------------------------------------------------------------*)
  413.  
  414.     IF NOT up_it THEN
  415.       BEGIN;
  416.  
  417.         (*-------------------------------------------------------------------*)
  418.         (* Send the file                                                     *)
  419.         (*-------------------------------------------------------------------*)
  420.  
  421.         (*-------------------------------------------------------------------*)
  422.         (* Use the file name specified                                       *)
  423.         (*-------------------------------------------------------------------*)
  424.  
  425.         pkfname := work_string;
  426.  
  427.         (*-------------------------------------------------------------------*)
  428.         (* Set the show flags                                                *)
  429.         (*-------------------------------------------------------------------*)
  430.  
  431.         save_show                     := active_tcb^.tcb_no_show_sdata;
  432.         active_tcb^.tcb_no_show_sdata := NOT opt_block.opt_show_binary;
  433.  
  434.         (*-------------------------------------------------------------------*)
  435.         (* Throw away anything that has arrived                              *)
  436.         (*-------------------------------------------------------------------*)
  437.  
  438.         flush_input_buffers;
  439.  
  440.         (*-------------------------------------------------------------------*)
  441.         (* Do the download                                                   *)
  442.         (*-------------------------------------------------------------------*)
  443.  
  444.         CASE bin_xfer OF
  445.           bin_yapp                     : yapp_xfer;
  446.           bin_xmodem..bin_ymodem_batch : xy_xfer;
  447.         END;
  448.  
  449.         (*-------------------------------------------------------------------*)
  450.         (* Restore the show/noshow flags                                     *)
  451.         (*-------------------------------------------------------------------*)
  452.  
  453.         active_tcb^.tcb_no_show_sdata := save_show;
  454.  
  455.         (*-------------------------------------------------------------------*)
  456.         (* If we are ok, tell user and log it                                *)
  457.         (*-------------------------------------------------------------------*)
  458.  
  459.         IF (NOT active_tcb^.error_sw) AND (NOT abort_sw) THEN
  460.           BEGIN;
  461.             do_mess(message_bin_done);
  462.             log_data_s(cmd_string);
  463.           END;
  464.  
  465.         (*-------------------------------------------------------------------*)
  466.         (* Close things                                                      *)
  467.         (*-------------------------------------------------------------------*)
  468.  
  469.         close_things_up;
  470.  
  471.         (*-------------------------------------------------------------------*)
  472.         (* Leave things                                                      *)
  473.         (*-------------------------------------------------------------------*)
  474.  
  475.         EXIT;
  476.  
  477.       END; (*----- End of IF statement for download -------------------------*)
  478.  
  479.     (*-----------------------------------------------------------------------*)
  480.     (* Build temp file name                                                  *)
  481.     (*-----------------------------------------------------------------------*)
  482.  
  483.     pkfname := opt_block.msg_file_dir + active_tcb^.port_chan_s + '.IN';
  484.  
  485.     (*-----------------------------------------------------------------------*)
  486.     (* Set the show switches both for local task and for distant             *)
  487.     (*-----------------------------------------------------------------------*)
  488.  
  489.     save_show                     := active_tcb^.tcb_no_show_sdata;
  490.     active_tcb^.tcb_no_show_sdata := NOT opt_block.opt_show_binary;
  491.  
  492.     (*-----------------------------------------------------------------------*)
  493.     (* Throw away anything received until now                               *)
  494.     (*-----------------------------------------------------------------------*)
  495.  
  496.     flush_input_buffers;
  497.  
  498.     (*-----------------------------------------------------------------------*)
  499.     (* Receive the file                                                      *)
  500.     (*-----------------------------------------------------------------------*)
  501.  
  502.     CASE bin_xfer OF
  503.       bin_yapp                     : yapp_xfer;
  504.       bin_xmodem..bin_ymodem_batch : xy_xfer;
  505.     END;
  506.  
  507.     (*-----------------------------------------------------------------------*)
  508.     (* Restore show switchss                                                *)
  509.     (*-----------------------------------------------------------------------*)
  510.  
  511.     active_tcb^.tcb_no_show_sdata := save_show;
  512.  
  513.     (*-----------------------------------------------------------------------*)
  514.     (* Close things                                                          *)
  515.     (*-----------------------------------------------------------------------*)
  516.  
  517.     close_things_up;
  518.  
  519.     (*-----------------------------------------------------------------------*)
  520.     (* If an error has occurred, leave                                       *)
  521.     (*-----------------------------------------------------------------------*)
  522.  
  523.     IF active_tcb^.error_sw OR abort_sw THEN
  524.       EXIT;
  525.  
  526.     (*-----------------------------------------------------------------------*)
  527.     (* Copy file                                                             *)
  528.     (*-----------------------------------------------------------------------*)
  529.  
  530.     work_string := copy_file_binary(pkfname, work_string, FALSE);
  531.  
  532.     (*-----------------------------------------------------------------------*)
  533.     (* Report any errors                                                     *)
  534.     (*-----------------------------------------------------------------------*)
  535.  
  536.     IF work_string <> '' THEN
  537.       BEGIN;
  538.         send_tnc_data_str(work_string + cr);
  539.         active_tcb^.error_sw := TRUE;
  540.         EXIT;
  541.       END;
  542.  
  543.     (*-----------------------------------------------------------------------*)
  544.     (* No errors!  Tell user and logit                                       *)
  545.     (*-----------------------------------------------------------------------*)
  546.  
  547.     do_mess(message_file_saved);
  548.  
  549.     log_data_s(cmd_string);
  550.  
  551.   END;
  552.  
  553. END.
  554.